## Warning: package 'reactable' was built under R version 4.1.3
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.2     v dplyr   1.0.7
## v tidyr   1.1.3     v stringr 1.4.0
## v readr   2.0.0     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## `summarise()` has grouped output by 'state'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'state'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'state'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'state'. You can override using the `.groups` argument.
## `mutate_if()` ignored the following grouping variables:
## Column `state`

*IR=incidence rate, MR=mortality rate, TR=testing rate, TPR=test-positivity ratio, Rt=time-varying reproductive number, BOR=Bed-occupancy rate, IOR= ICU-occupancy rate, VOR=ventilator-utilisation rate, % change calculated as the percentage change of indicator compared to the last week

library(reactable)
library(htmltools)
library(tidyverse)

transmission <- read.csv('../data/transmission.csv')
testing <- read.csv('../data/testing.csv')
capacity <- read.csv('../data/capacity.csv')
mobility <- read.csv('../data/mobility.csv')
vaccination <- read.csv('../data/vaccination.csv')

transmission_7day <- transmission %>% group_by(state) %>%
  mutate(date=as.Date(date),
         ir_7day=round(as.numeric(ir_7day),1),
         mr_7day=round(as.numeric(mr_7day),1),
         rt=round(as.numeric(rt),1),
         lower=round(as.numeric(lower),1),
         upper=round(as.numeric(upper),1)) %>%
  filter(date>max(date)-14) %>%
  mutate(week=ifelse(date>max(date)-7,1,2)) %>%
  ungroup() %>% as.data.frame() %>%
  group_by(state, week) %>%
  summarise(mean_ir=mean(ir_7day),
            mean_mr=mean(mr_7day),
            mean_rt=mean(rt),
            mean_lower=mean(lower),
            mean_upper=mean(upper)) %>%
  ungroup() %>%
  group_by(state) %>%
  mutate(perc_change_ir=round(((mean_ir-lag(mean_ir))/lag(mean_ir))*100,1),
         perc_change_mr=round(((mean_mr-lag(mean_mr))/lag(mean_mr))*100,1),
         perc_change_rt=round(((mean_rt-lag(mean_rt))/lag(mean_rt))*100,1),
         mean_rt_full=paste0(round(mean_rt,2), " (", round(mean_lower,1), ", ", round(mean_upper,1), ")")) %>%
  filter(week==2) %>%
  select(-week)

test_7day <- testing %>% group_by(state) %>%
  mutate(date=as.Date(date),
         ma_7day_tr=round(as.numeric(ma_7day_tr),1),
         ma_7day_tpr=ma_7day_tpr/100) %>%
  filter(date>max(date)-14) %>%
  mutate(week=ifelse(date>max(date)-7,1,2)) %>%
  ungroup() %>% as.data.frame() %>%
  group_by(state, week) %>%
  summarise(mean_tpr=mean(ma_7day_tpr),
            mean_tr=mean(ma_7day_tr)) %>%
  ungroup() %>%
  group_by(state) %>%
  mutate(perc_change_tpr=round(((mean_tpr-lag(mean_tpr))/lag(mean_tpr))*100,1),
         perc_change_tr=round(((mean_tr-lag(mean_tr))/lag(mean_tr))*100,1),
         trend_tpr=ifelse(perc_change_tpr<0, "down", 
                          ifelse(perc_change_tpr>0, "up", "unchanged"))) %>%
  filter(week==2) %>%
  select(-week)

capacity_7day <- capacity %>% group_by(state) %>%
  mutate(date=as.Date(date),
         bor=bor/100,
         ior=ior/100,
         vor=vor/100) %>%
  filter(date>max(date)-14) %>%
  mutate(week=ifelse(date>max(date)-7,1,2)) %>%
  ungroup() %>% as.data.frame() %>%
  group_by(state, week) %>%
  summarise(mean_bor=mean(bor),
            mean_ior=mean(ior),
            mean_vor=mean(vor)) %>%
  ungroup() %>%
  group_by(state) %>%
  mutate(perc_change_bor=round(((mean_bor-lag(mean_bor))/lag(mean_bor))*100,1),
         perc_change_ior=round(((mean_ior-lag(mean_ior))/lag(mean_ior))*100,1),
         perc_change_vor=round(((mean_vor-lag(mean_vor))/lag(mean_vor))*100,1),
         trend_bor=ifelse(perc_change_bor<0, "down", 
                          ifelse(perc_change_bor>0, "up", "unchanged")),
         trend_ior=ifelse(perc_change_ior<0, "down", 
                          ifelse(perc_change_ior>0, "up", "unchanged")),
         trend_vor=ifelse(perc_change_vor<0, "down", 
                          ifelse(perc_change_vor>0, "up", "unchanged"))) %>%
  filter(week==2) %>%
  select(-week)


vaccination_7day <- vaccination %>% group_by(state) %>%
  mutate(date=as.Date(date),
         perc_vax2=perc_vax2/100,
         perc_booster=perc_booster/100) %>%
  filter(date>max(date)-14) %>%
  mutate(week=ifelse(date>max(date)-7,1,2)) %>%
  ungroup() %>% as.data.frame() %>%
  group_by(state, week) %>%
  summarise(max_vax2=max(perc_vax2),
            max_booster=max(perc_booster)) %>%
  ungroup() %>%
  group_by(state) %>%
  mutate(perc_vax2_change=round(((max_vax2-lag(max_vax2))/lag(max_vax2))*100,1),
         perc_booster_change=round(((max_booster-lag(max_booster))/lag(max_booster))*100,1),
         trend_vax2=ifelse(perc_vax2_change<0, "down", 
                          ifelse(perc_vax2_change>0, "up", "unchanged")),
         trend_booster=ifelse(perc_booster_change<0, "down", 
                          ifelse(perc_booster_change>0, "up", "unchanged"))) %>%
  filter(week==2) %>%
  select(-week) 

#join all the sets
epid_report <- left_join(transmission_7day, test_7day, by="state") %>%
  left_join(capacity_7day, by="state") %>%
  left_join(vaccination_7day, by="state") %>%
  na.omit() %>%
  mutate_if(is.numeric, function(x) ifelse(is.infinite(x), 0, x)) %>%
  as.data.frame() %>% mutate_if(is.numeric, round, digits=2)

epid_report_msia <- epid_report %>% filter(state=="Malaysia") %>% mutate(state=as.factor(state))
epid_report_state <- epid_report %>% filter(state!="Malaysia") %>%
  mutate(state=as.factor(state)) %>%
  arrange(desc(mean_ir))
epid_report <- bind_rows(epid_report_msia, epid_report_state)

#write epid report to csv
write.csv(epid_report, "../data/epid_report.csv")

#prepare the columns for the epid report
trans_cols <- c("mean_ir", "perc_change_ir", "mean_mr", "perc_change_mr", "mean_rt_full", "perc_change_rt")
test_cols <- c("mean_tpr", "trend_tpr", "mean_tr", "perc_change_tr")
capacity_cols <- c("mean_bor", "trend_bor", "mean_ior", "trend_ior", "mean_vor", "trend_vor")
vax_cols <- c("max_vax2", "trend_vax2", "max_booster", "trend_booster")

#all colims
epid_report <- epid_report[, c("state", trans_cols, test_cols, capacity_cols, vax_cols)]

change_column <- function(maxWidth = 60, ...) {
  colDef(maxWidth = maxWidth, align = "center", class = "cell number", ...)
}

number_column <- function(class = NULL, ...) {
  colDef(align = "center", class = paste("cell number", class), ...)
}

number_col_column <- function(class = NULL, ...) {
  colDef(maxWidth = 60, align = "center", class = paste("cell number", class), 
         ...)
}

perc_column <- function(maxWidth = 40, class = NULL, ...) {
  colDef(
    align = "center",
    cell = format_pct,
    maxWidth = maxWidth,
    class = paste("cell number", class),
    style = function(value) {
      # Lighter color for <1%
      if (value < 0.01) {
        list(color = "#aaa")
      } else {
        list(color = "#111", background = knockout_pct_color(value))
      }
    },
    ...
  )
}

format_pct <- function(value) {
  if (value == 0) "  \u2013 "    # en dash for 0%
  else if (value == 1) "\u2713"  # checkmark for 100%
  else if (value < 0.01) " <1%"
  else if (value > 0.99) ">99%"
  else formatC(paste0(round(value * 100), "%"), width = 4)
}

make_color_pal <- function(colors, bias = 1) {
  get_color <- colorRamp(colors, bias = bias)
  function(x) rgb(get_color(x), maxColorValue = 255)
}

off_rating_color <- make_color_pal(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 1.3)
off_rating_color2 <- make_color_pal(c("#44ab43", "#f8fcf8",  "#ff2700"), bias = 1.3)
knockout_pct_color <- make_color_pal(c("#009c1a", "#22b600",  "#26cc00", "#7be382", "#d2f2d4", "#ffdc73", "#ffcf40", "#ffbf00", "#bf9b30", "#a67c00"), bias = 2)

# Icon to indicate trend: unchanged, up, down, or new
trend_indicator <- function(value = c("unchanged", "up", "down", "new")) {
  value <- match.arg(value)
  label <- switch(value,
                  unchanged = "Unchanged", up = "Trending up",
                  down = "Trending down", new = "New")

  # Add img role and tooltip/label for accessibility
  args <- list(role = "img", title = label)

  if (value == "unchanged") {
    args <- c(args, list("–", style = "color: #666; font-weight: 700"))
  } else if (value == "up") {
    args <- c(args, list(shiny::icon("caret-up"), style = "color: #1ed760"))
  } else if (value == "down") {
    args <- c(args, list(shiny::icon("caret-down"), style = "color: #cd1a2b"))
  } else {
    args <- c(args, list(shiny::icon("circle"), style = "color: #2e77d0; font-size: 10px"))
  }
  do.call(span, args)
}

tbl <- reactable(
  epid_report,
  pagination = FALSE,
  defaultColGroup = colGroup(headerClass = "group-header"),
  columnGroups = list(
    colGroup(name = "Transmission", columns = trans_cols),
    colGroup(name = "Testing", columns = test_cols),
    colGroup(name = "Healthcare capacity", columns = capacity_cols),
    colGroup(name = "Vaccination", columns = vax_cols)
    
  ),
  defaultColDef = colDef(class = "cell", headerClass = "header"),
  columns = list(
    state = colDef(
      maxWidth = 90,
      headerStyle = list(fontWeight = 400), 
      name="State",
      cell = function(value) {
        img_src <- knitr::image_uri(sprintf("../images/%s.png", value))
        image <- img(src = img_src, height = "36px", alt = "")
        tagList(
          div(style = list(display = "inline-block", width = "70px"), image),
          value
        )
      }
    ),
    # date = colDef(defaultSortOrder = "asc", align = "center", maxWidth = 75, name="Date",
    #                class = "cell group", headerStyle = list(fontWeight = 700)),
    mean_ir = number_col_column(name = "7-day IR"),
    perc_change_ir = change_column(
      name = "% change*",
      cell = function(value) {
        scaled <- 1-(value - min(epid_report$perc_change_ir)) / (max(epid_report$perc_change_ir) - min(epid_report$perc_change_ir))
        color <- off_rating_color(scaled)
        value <- format(round(value, 1), nsmall = 1)
        div(class = "date-rating", style = list(background = color), value)
      }
    ),
    mean_mr = number_col_column(name = "7-day MR"),
    perc_change_mr = change_column(
      name = "% change*",
      cell = function(value) {
        scaled <- 1-(value - min(epid_report$perc_change_mr)) / (max(epid_report$perc_change_mr) - min(epid_report$perc_change_mr))
        color <- off_rating_color(scaled)
        value <- format(round(value, 1), nsmall = 1)
        div(class = "date-rating", style = list(background = color), value)
      }
    ),
    mean_rt_full = number_column(name = "Rt", maxWidth = 70),
    perc_change_rt = change_column(
      name = "% change*",
      cell = function(value) {
        scaled <- 1-(value - min(epid_report$perc_change_rt)) / (max(epid_report$perc_change_rt) - min(epid_report$perc_change_rt))
        color <- off_rating_color(scaled)
        value <- format(round(value, 1), nsmall = 1)
        div(class = "date-rating", style = list(background = color), value)
      }
    ),
   
    mean_tpr = perc_column(name = "TPR (%)"),
    trend_tpr = colDef(
        header = span("TPR trend", class = "sr-only"),
        sortable = FALSE,
        align = "center",
        width = 30,
        cell = function(value) trend_indicator(value)
      ),
    mean_tr = number_col_column(name = "TR"),
    perc_change_tr = change_column(
      name = "% change*",
      cell = function(value) {
        scaled <- 1-(value - min(epid_report$perc_change_tr)) / (max(epid_report$perc_change_tr) - min(epid_report$perc_change_tr))
        color <- off_rating_color(scaled)
        value <- format(round(value, 1), nsmall = 1)
        div(class = "date-rating", style = list(background = color), value)
      }
    ),
    
    mean_bor = perc_column(name = "BOR (%)"),
    trend_bor = colDef(
        header = span("BOR trend", class = "sr-only"),
        sortable = FALSE,
        align = "center",
        width = 30,
        cell = function(value) trend_indicator(value)
      ),
    mean_ior = perc_column(name = "IOR (%)"),
    trend_ior = colDef(
        header = span("Trend", class = "sr-only"),
        sortable = FALSE,
        align = "center",
        width = 30,
        cell = function(value) trend_indicator(value)
      ),
    mean_vor = perc_column(name = "VOR (%)"),
    trend_vor = colDef(
        header = span("Trend", class = "sr-only"),
        sortable = FALSE,
        align = "center",
        width = 30,
        cell = function(value) trend_indicator(value)
      ),
    
    max_vax2 = perc_column(name = "Full-dose (%)"),
    trend_vax2 = colDef(
        header = span("Trend", class = "sr-only"),
        sortable = FALSE,
        align = "center",
        width = 30,
        cell = function(value) trend_indicator(value)
      ),
    max_booster = perc_column(name = "Booster (%)"),
    trend_booster = colDef(
        header = span("Trend", class = "sr-only"),
        sortable = FALSE,
        align = "center",
        width = 30,
        cell = function(value) trend_indicator(value)
      )
  ),
  # Emphasize borders between groups when sorting by group
  rowClass = JS("
    function(rowInfo, state) {
      const firstSorted = state.sorted[0]
      if (firstSorted && firstSorted.id === 'group') {
        const nextRow = state.pageRows[rowInfo.viewIndex + 1]
        if (nextRow && rowInfo.row.group !== nextRow.group) {
          return 'group-last'
        }
      }
    }"
  ),
  showSortIcon = FALSE,
  borderless = TRUE,
  class = "standings-table")



div(class = "standings",
    div(class = "title",
        h2(" "),
        ""
    ),
    tbl,
    "*IR=incidence rate, MR=mortality rate, TR=testing rate, TPR=test-positivity ratio, Rt=time-varying reproductive number, BOR=Bed-occupancy rate, IOR= ICU-occupancy rate, VOR=ventilator-utilisation rate, % change calculated as the percentage change of indicator compared to the last week"
)

saveRDS(tbl, '../plots/epid_report_tbl.rds')